(define-module (grump compression)
  #:use-module (ice-9 popen)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 textual-ports)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-26))

(define 7z-executable "7z")

(define (run-command cmd . args)
  (format #t "Running: ~a\n" (cons cmd args))
  (let* ((port (apply open-pipe* OPEN_READ cmd args))
         (lines (get-lines port)))
    (close-port port)
    lines))

(define (get-lines port)
  (let loop ((lines '()))
    (let ((line (get-line port)))
      (if (eof-object? line)
          (reverse! lines)
          (loop (cons line lines))))))

(define (take-between start-pred end-pred ls)
  (take-while
   (negate end-pred)
   (cdr (drop-while
         (negate start-pred) ls))))

(define-record-type <7z-entry>
  (make-7z-entry datetime attr size compressed name)
  7z-entry?
  (datetime   7z-entry-datetime)
  (attr       7z-entry-attr)
  (size       7z-entry-size)
  (compressed 7z-entry-compressed)
  (name       7z-entry-name))

(define (7z-entry-is-dir? entry)
  (string-prefix? "D" (7z-entry-attr entry)))

(define (parse-7z-entry line)
  (let* ((regex (string-append "^([0-9]{4}-[0-9]{2}-[0-9]{2}" ; date
                               " [0-9]{2}:[0-9]{2}:[0-9]{2})" ; time
                               " ([^ ]{5})"                   ; attr
                               " +([0-9]+)"                   ; size
                               " ( +([0-9]+) )?"              ; compressed
                               " +(.*)$"))                    ; name
         (match (string-match regex line)))
    (and match (make-7z-entry (match:substring match 1)     ; datetime
                              (match:substring match 2)     ; attr
                              (match:substring match 3)     ; size
                              (match:substring match 5)     ; compressed
                              (match:substring match 6))))) ; name

(define (list-7z path)
  (let* ((separator (cut string-prefix? "----------" <>))
         (lines (run-command 7z-executable "l" path))
         (lines (take-between separator separator lines)))
    (map parse-7z-entry lines)))
